perm filename BEAM1[1,LCS] blob
sn#816382 filedate 1986-05-01 generic text, type T, neo UTF8
C**** BEAMS.F4 ****
COPYRIGHT 1986 BY LELAND SMITH
C*** BEAMS, BMREAD, NREST, NOTAIL, FUZZ ************
SUBROUTINE BEAMS
INTEGER UPDN
COMMON /STF/RSTFAC(8),RSTJ2
1 /XRN/RN(1) /RNW/RNW /A2Z/LAA,LBB
1 /dpymem/R(15,150),rpos(2,100),POSNT(150),RHY(100),jstdir(150)
1 ,ntptr(150)
1 /RMOD/staff,SET4,IBEAM,NOSET,STEM,JSTUP,NTC,PS2,IZ,JSTEM,
1 IRHY,POSB /ALF/INP(100) /LIMIT/LIMIT,ITEM,LL,IRN,IX
1 /mode/mode,jm,ioct,mm,nn,motend,ichd /v/kv,v(150)
DATA TILT/2.0/
write(*,*)kv,(v(j),j=1,kv)
INVT=-1
LS=IRN
C SAVE PTR TO RN ARRAY FOR SLUR FEATURE AT 614 (AND TREM. FEATURE)
JNTC=NTC
c NTC is note count??
J=0
A=-1.
DO 1125 K=1,IZ
RHY(K)=0.
C MUST BE ZEROED TO AVOID CONFUSION AT C.2212
IF(R(1,K).GT.2.)GO TO 1125
C GET BACK RHYTH. INFO IN P7 OF NOTES (FOR JDIF, COMPOSITE BEAMS)
B=R(3,K)
IF(A.EQ.B)GO TO 1125
C SKIP CHORD NOTES.
A=B
J=J+1
rhy(k)=r(7,j)
c why not do this in RHYTHM???????
c RHY holds complete list of note rhythms (make rests neg??)
1125 CONTINUE
if(v(1).ne.9999.)GO TO 500
c 'B' puts 9999 in first slot
C TYPE 'nB' OR 'nBj' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE 3=TRIPLE)
A=V(2)/2.
JB=V(3)
C '2'=1 '3'=1.5 '2B3;' MEANS THERE'S A 3 NOTE PICK-UP.
C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
N=0
J=0
NN=0
NX=0
C NX IS REST COUNTER
NZ=0
NL=1
NJ=0
NR=1
JV=0
C JV IS VX COUNTER
C=0.
B=A-.001
IF(JB.EQ.0)GO TO 122
C JB=NUM OF PICKUP ITEMS.***(NTS AND RSTS - BUT NOT GRACE NTS.)****
B=-.001
DO 222 K=1,JB
c222 IF(V(K).LT.64.)B=B+ABS(V(K))
222 if(rhy(k).lt.64.)b=b+abs(rhy(k)) C ABOVE FOUND VALUE OF PICKUPS
122 X=ABS(rhy(NR))
c NR is rhythm counter
IF(X.LT.64.)GO TO 2122
NN=NN+1
GO TO 2022
2122 C=C+X
C ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
IF(rhy(NR).LT.0.)N=N+1
C FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
IF(C.GT.B)GO TO 822
2022 IF(NR.EQ.IRHY)GO TO 422
922 NR=NR+1
C NR=RIGHT SIDE OF BEAM, NL=LEFT
GO TO 122
822 IF(NR-NL-NN-N.GT.0)GO TO 322
C IGNORE IF ONLY ONE NOTE FILLS UNIT
722 IF(NR.EQ.IRHY)GO TO 422
NN=0
NJ=NJ+N
NZ=NJ
N=0
NL=NR+1
C PUSH AHEAD FOR NEXT BEAM
622 B=B+A
C UPDATE SPACE POINTER
IF(C.GT.B)GO TO 622
GO TO 922
C MAIN AUTO BEAM SECTION.
322 DO 21 K=NL,NR-1
C THIS LOOP FINDS FIRST NOTE OF BEAM.
X=rhy(K)
IF(X.LT.0.)GO TO 21
IF(X.GE.64.)GO TO 21
IF(NOTAIL(X).LT.0)GO TO 21
C SKIP IF NOTE VAL. DOESN'T REQUIRE A TAIL
COUNTER FOR VX ARRAY (WHERE WE PUT BEAM'S NOTE NUMS.)
V(JV+1)=K-NREST(K)
C FUNCT. NREST TELLS HOW MANY RESTS TO SUBTRACT
GO TO 221
21 CONTINUE
C IF WE GET HERE, NO BEAM NOTES FOUND.
GO TO 722
221 DO 321 JB=K,NR
C THIS LOOP FINDS LAST NOTE OF BEAM.
X=rhy(JB)
IF(NOTAIL(X).LT.0)GO TO 522
C JUMP OUT WHEN NON-BEAM DURATION IS FOUND
IF(X.LT.0.)GO TO 321
IF(X.GE.64.)GO TO 321
JA=JB
321 CONTINUE
522 IF(JA.EQ.K)GO TO 523
JV=JV+2
V(JV)=JA-NREST(JA)
C NREST SUBTRACTS ALL INTERVENING RESTS
523 IF(JA.GE.NR-1)GO TO 722
C NO ROOM FOR MORE BEAMS
NL=JB
C START FROM WHERE WE LEFT OFF
GO TO 322
C NEXT FOR BEAMED GRACE NOTES
422 N=0
J=1
1122 X=rhy(J)
IF(X.LT.0.)N=N+1
NR=0
IF(X.LT.64.)GO TO 1022
NL=J
DO 1222 K=J,IRHY
X=rhy(K)
IF(X.LT.0..OR.X.LT.64.)GO TO 1322
C STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
1222 NR=K
1322 IF(NR-NL.LE.0)GO TO 1022
CALL BAUTO(JV,NL,NR,N)
C UPDATE V COUNTER
NL=NL+1
J=NR
1022 J=J+1
IF(J.LE.IRHY)GO TO 1122
1422 IF(JV.EQ.0)RETURN
C NO BEAMS - SO GO BACK.
DO 2822 K=JV+1,50
C ?? USES ONLY 68 SLOTS IN 'V'
2822 V(K)=0.
J=0
GO TO 511
C ******* 1ST MAIN LOOP *********
500 J=0
511 J=J+1